home *** CD-ROM | disk | FTP | other *** search
/ Dr. Windows 3 / dr win3.zip / dr win3 / PROGRAMR / SWTOOLS.ZIP / SWDEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1993-03-09  |  11KB  |  324 lines
  1. program SWToolsDemo;
  2.  
  3. {ShareWare Tools  (c) 1992 Scott Gifford.  All Rights Reserved.}
  4.  
  5.  
  6. {This program was written in Turbo Pascal for Windows V1.5.  I have tried
  7.  my best, however, to make it understandable for programmers in all languages
  8.  with my comments.  If you still don't understand something, or if you have
  9.  any type of question about this program, please contact me at one of the
  10.  addresses listed under Questions, Problems, and Comments in the SWTools.HLP
  11.  file.}
  12.  
  13.                  {Thank you for trying SWTools!}
  14.  
  15.                                                 {---Scott.}
  16.  
  17.  
  18.   {The following command causes a resource file to be included.}
  19. {$r swdemo}
  20.  
  21.   {These units are included in most Windows applications}
  22. uses WObjects,WinTypes,WinProcs,Strings,WinCRT;
  23.  
  24. const
  25.   pw:array[0..8] of char='password';                 {program password}
  26.   TrialPeriod=30;                                    {Length of trial period}
  27.   RegPath:packed array[0..15] of char='swdemo.reg';  {Registration file}
  28.   DGBPath:packed array[0..15] of char='swdemo.dgb';  {DateStamp file}
  29.  
  30.   id_register=110;                                   {A button in the DBs}
  31.   id_proceed=111;                                    {Another button}
  32.   id_quit=112;                                       {Yet another button}
  33.   id_DaysLeft=121;                                   {A static from a DB}
  34.   id_name=101;                                       {Edit control ID}
  35.   id_reg=102;                                        {  "     "     "}
  36.   id_quest=103;                                      {  "     "     "}
  37.   id_FavColor=104;                                   {  "     "     "}
  38.  
  39.   id_scram=120;                         {Scramble button}    
  40.   id_date=121;                                       {MakeDate button}
  41.   id_help=122;                                       {help button}
  42.   id_QuestBtn=123;                                   {quest button}
  43.   id_FavColorBtn=124;                                {favorite coloe button}
  44.  
  45. type
  46.   Str10=array[0..10] of char;     {TPW treats these arrays as pointers to
  47.                                     null-terminated strings}
  48.  
  49. var {global}
  50.   Registered:integer;             {1 if registered}
  51.   Name,                           {Registration name}
  52.   Quest,                          {Reg. quest}
  53.   FavColor:Str10;                 {Reg. Favorite color}
  54.   
  55.  
  56.  
  57. {Importing the DLL.  If you don't speak TPW fluently, note that PChar
  58.  refers to a null-terminated string and PDosStream to a pointer to
  59.  a DOS stream.  If your language doesn't support either of these, just
  60.  use a plain old pointer.}
  61.  
  62. procedure scramble(what,password,result:PChar;v:integer);
  63.   far; external 'SWTOOLS1' index 1;
  64. function CreateDateFile(FileName,password:PChar;v:integer):integer;
  65.   far; external 'SWTOOLS1' index 2;
  66. function CreateNewDate(FileName,pw:PChar; v:integer):integer;
  67.   far; external 'SWTOOLS1' index 3;
  68. function DaysGoneBy(FileName,password:PChar;v:integer):integer;
  69.   far; external 'SWTOOLS1' index 4;
  70. function CheckRegistration(RegFile,Name,PassWord:PChar; more:integer;
  71.  var MoreToFollow:PDosStream;v:integer):integer;
  72.   far; external 'SWTOOLS1' index 5;
  73. procedure GetRegInfo(MoreFollowing:PDosStream; var ExtraInfo:Str10;v:integer);
  74.   far; external 'SWTOOLS1' index 7;
  75. procedure DoneWithInfo(MoreFollowing:PDosStream;v:integer);
  76.   far; external 'SWTOOLS1' index 9;
  77. procedure CreateRegistration(RegFile,name,PassWord:PChar; more:integer;
  78.  var MoreToFollow:PDosStream;v:integer);
  79.   far; external 'SWTOOLS1' index 6;
  80. procedure WriteRegInfo(MoreFollowing:PDosStream; ExtraInfo:PChar;v:integer);
  81.   far; external 'SWTOOLS1' index 8;
  82.  
  83.  
  84.  {The definition for the registration DB}
  85. type
  86.   PRegister=^TRegister;
  87.   TRegister=object(TDialog)
  88.    {The following two methods respond to an id_register and id_quit message
  89.     from Windows, sent when the Register and Quit buttons in this DB are
  90.     pressed.  For the actual values of these, see const section above.}
  91.  
  92.     procedure IDRegister(var msg:TMessage);
  93.       virtual id_first + id_register;
  94.     procedure IDQuit(var msg:TMessage);
  95.       virtual id_first + id_quit;
  96.   end;
  97.  
  98. procedure TRegister.IDRegister(var msg:TMessage);
  99.  {Reaction to the Register button being pressed}
  100.  {To generate a registration number for yourself, use the Scrambler tool.
  101.   For more information, read the help file.}
  102.  
  103.   var
  104.     name,                {Name from the edit}
  105.     ReadReg,             {Reg    "   "    " }
  106.     RealReg,             {Reg the program figured out}
  107.     temp:Str10;          {The approximate temperature in Geneva, Switzerland}
  108.                            {also used as a temporary variable}
  109.     RegFile:PDosStream;  {For disk I/O}
  110.  
  111.   begin
  112.  
  113.     {Retrieve the name and reg number}
  114.     GetDlgItemText(HWindow,id_name,name,11);
  115.     GetDlgItemText(HWindow,id_reg,ReadReg,11);
  116.  
  117.     {Figure out what the Reg # SHOULD have been}
  118.     Scramble(name,pw,RealReg,1);
  119.  
  120.     {Compare it to the one read in}
  121.     if StrIComp(ReadReg,RealReg)<>0
  122.       then begin
  123.        {If they are different,send a message and return to the DB}
  124.         MessageBox(HWindow,'That is not the correct registration code',
  125.           'Bad Reg #',mb_OK);
  126.         exit;
  127.       end;
  128.  
  129.     {Otherwise, create a registration file}
  130.     CreateRegistration(RegPath,name,pw,1,RegFile,1);
  131.  
  132.     {In addition to the name and reg #, send the quest and favorite color}
  133.     GetDlgItemText(HWindow,id_quest,temp,11);
  134.     WriteRegInfo(RegFile,temp,1);
  135.     GetDlgItemText(HWindow,id_FavColor,temp,11);
  136.     WriteRegInfo(RegFile,temp,1);
  137.     {ALWAYS REMEMBER TO CALL THIS WHEN DONE WITH THE REG FILE!}
  138.     DoneWithInfo(RegFile,1);
  139.  
  140.     {Exit the dialog and return 1}
  141.     EndDlg(1);
  142.   end;
  143.  
  144. procedure TRegister.IDQuit(var msg:TMessage);
  145.  {Respond to the Quit button by ending the dialog and returning 0}
  146.   begin
  147.     EndDlg(0);
  148.   end;
  149.  
  150.  
  151.  
  152. {The definition for the TimesUp DB, and for the PleaseReg DB}
  153. {The two DBs are so similar, they only need one definition.}
  154.  
  155. type
  156.   PTimesUp=^TTimesUp;
  157.   TTimesUp=object(TDialog)
  158.     procedure SetUpWindow;
  159.       virtual;
  160.     procedure IDRegister(var msg:TMessage);
  161.       virtual id_first + id_register;
  162.     procedure IDQuit(var msg:TMessage);
  163.       virtual id_first + id_quit;
  164.   end;
  165.  
  166. procedure TTimesUp.SetUpWindow;
  167.  {Changes the static with ID id_DaysLeft to the actual number of days left.}
  168.   var
  169.     DaysLeft:array[0..2] of char;
  170.   begin
  171.     Str(DaysGoneBy(DGBPath,pw,1):2,DaysLeft);
  172.     Str(TrialPeriod-DaysGoneBy(DGBPath,pw,1):2,DaysLeft);
  173.     SetDlgItemText(HWindow,id_daysleft,DaysLeft);
  174.   end;
  175.  
  176. procedure TTimesUp.IDRegister(var msg:TMessage);
  177.  {Reacts to the Register button by creating the Register DB.
  178.   If it returns 1 (i.e. if they registered), returns a 1 and allows
  179.   them to go on with the program.  Otherwise, leaves them with
  180.   this DB again.}
  181.   begin
  182.     if Application^.ExecDialog(new(PRegister,init(@self,'REGISTER')))=1 then EndDlg(1);
  183.   end;
  184.  
  185. procedure TTimesUp.IDQuit(var msg:TMessage);
  186.  {Reacts to the Quit button by closing the DB and returning a 0}
  187.   begin
  188.     EndDlg(0);
  189.   end;
  190.  
  191.  
  192.  {Definition for the main window}
  193. type
  194.   PDemoWin=^TDemoWin;
  195.   TDemoWin=object(TWindow)
  196.  
  197.     constructor init(AParent:PWindowsObject; AName:PChar);
  198.  
  199.     procedure SetUpWindow;
  200.       virtual;
  201.  
  202.     procedure IDScram(var msg:TMessage);
  203.       virtual id_first + id_scram;
  204.     procedure IDDate(var msg:TMessage);
  205.       virtual id_first + id_date;
  206.     procedure IDQuestBtn(var msg:TMessage);
  207.       virtual id_first + id_questBtn;
  208.     procedure IDFavColorBtn(var msg:TMessage);
  209.       virtual id_first + id_FavColorBtn;
  210.     procedure IDHelp(var msg:TMessage);
  211.       virtual id_first + id_help;
  212.   end;
  213.  
  214. constructor TDemoWin.init(AParent:PWindowsObject; AName:PChar);
  215.  {Creates the window and its buttons}
  216.   var
  217.     Button:PButton;
  218.   begin
  219.     TWindow.init(AParent,AName);
  220.     {Each of the following commands causes a button to be created.
  221.     The parameters are as follows: (parent,ID,title,x,y,width,height,default)}
  222.     Button:=new(PButton,init(@self,id_scram,'Scrambler',25,25,100,